home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 49 / Amiga Format CD49 (2000-01-17)(Future Publishing)(GB)(Track 1 of 3)[!][issue 2000-02].iso / -serious- / graphics / amicad / arexx / grille.amicad < prev    next >
Text File  |  1999-12-06  |  5KB  |  193 lines
  1. /* Création d'une grille quadrillée
  2. $VER: Grille.AmiCAD 1.04 (© R.Florac, 22/05/99)
  3. Version 1.00 ©R.Florac, Mardi 3 Mars 1998
  4. Version 1.01, 25 avril 1998 (utilisation d'un rectangle pour définir la zone recevant la grille)
  5. Version 1.02, 12 novembre 1998 (correction bug variables x0 et y0)
  6. Version 1.03, 29 Mars 1999 (ajout GETZONE)
  7. Version 1.04, 22 Mai 1999 (Modification DRAWMODE) */
  8.  
  9. options results     /* indispensable pour récupérer le résultat des macros */
  10.  
  11. signal on error     /* pour l'interception des erreurs */
  12. signal on syntax
  13.  
  14. 'WWIDTH(-1)'; lt = result
  15. 'WHEIGHT(-1)'; ht=result
  16. clip=-1
  17. FIRSTSEL; obj=result
  18. if obj>0 then do
  19.     'TYPE(FIRSTSEL)'; type=result
  20.     if type=22 then do
  21.     'CLIPUNIT(5)'; clip=result
  22.     'COORDS(FIRSTSEL)'; coords=result
  23.     PARSE VAR coords x0 ',' y0 ',' x1 ',' y1
  24.     xg=minima(x0,x1); xd=maxima(x0,x1)
  25.     yh=minima(y0,y1); yb=maxima(y0,y1)
  26.     l=xd-xg+1; h=yb-yh+1
  27.     'NEXTSEL('obj')'; obj=result
  28.     end
  29. end
  30. else obj=1
  31.  
  32. if obj>0 then do
  33.     'GETZONE("Premier coin du rectangle?","Deuxième coin?")'
  34.     coords=result
  35.     if coords="" then call quitter
  36.     PARSE VAR coords x0 ',' y0 ',' x1 ',' y1
  37.     xg=minima(x0,x1); xd=maxima(x0,x1)
  38.     yh=minima(y0,y1); yb=maxima(y0,y1)
  39.     l=xd-xg+1; h=yb-yh+1
  40. end
  41.  
  42. 'ASKNUM("Axe horizontal"+CHR(10)+"Nombre de décades?",1)'
  43. ndh = result
  44. if ndh<=0 then call quitter
  45. 'SELECT("Type d''échelle"+CHR(10)+"1- Linéaire"+CHR(10)+"2- Logarithmique"+CHR(10)+"3- Antilogarithmique")'
  46. tt=result
  47. x0=xg; y0=yh; y1=yh+h; x1=xg+ndh*(l%ndh)    /* Version 1.02 */
  48.  
  49. 'SAVEALL(-1)'
  50. if clip>=0 then 'MENU("Cut")'
  51. /* Tracé des lignes verticales */
  52. select
  53.     when tt=1 then do
  54.     /* Tracé des lignes verticales */
  55.     do i=1 to ndh
  56.         x2 = (x0)+i*(l/ndh)
  57.         x2 = x2%1
  58.         'DRAWMODE(-1)'
  59.         do c=1 to 9
  60.         xc = x2-(l/ndh)/10*c
  61.         xc=xc%1
  62.         'DRAW('xc','y0','xc','y1')'
  63.         end
  64.         'DRAWMODE(-2):DRAW('x2','y1','x2','y0')'
  65.     end
  66.     end
  67.     when tt=2 then do
  68.     if ~show('L','rexxmathlib.library') then
  69.        call addlib('rexxmathlib.library',0,-30)
  70.     /* Tracé des lignes verticales */
  71.     x2=x0
  72.     do i=1 to ndh
  73.         'DRAWMODE(-1)'
  74.         do c=2 to 9
  75.         xc=(l/ndh)*log10(c)
  76.         xc=(x2+xc)%1
  77.         'DRAW('xc','y0','xc','y1')'
  78.         end
  79.         x2 = (x0)+i*(l/ndh)
  80.         x2 = x2%1
  81.         'DRAWMODE(-2):DRAW('x2','y1','x2','y0')'
  82.     end
  83.     end
  84.     when tt=3 then do
  85.     if ~show('L','rexxmathlib.library') then
  86.        call addlib('rexxmathlib.library',0,-30)
  87.     x2=x1
  88.     do i=1 to ndh
  89.         'DRAWMODE(-2):DRAW('x2','y1','x2','y0')'
  90.         'DRAWMODE(-1)'
  91.         do c=2 to 9
  92.         xc=(l/ndh)*log10(c)
  93.         xc=(x2-xc)%1
  94.         'DRAW('xc','y0','xc','y1')'
  95.         end
  96.         x2 = (x1)-i*(l/ndh)
  97.         x2 = x2%1
  98.     end
  99.     end
  100.     otherwise call quitter
  101. end
  102.  
  103. 'ASKNUM("Axe vertical"+CHR(10)+"Nombre de décades?",1)'
  104. ndv = result
  105. if ndv<=0 then call quitter
  106.  
  107. y1=y0+h
  108. x1=x0+ndh*(l%ndh)
  109. /* Tracé du contour */
  110. 'DRAWMODE(-2):DRAW('x0','y0','x1','y0'):DRAW('x0','y1','x0','y0')'
  111.  
  112. 'SELECT("Type d''échelle"+CHR(10)+"1- Linéaire"+CHR(10)+"2- Logarithmique"+CHR(10)+"3- Antilogarithmique")'
  113. tt=result
  114.  
  115. /* Tracé des lignes horizontales */
  116. select
  117.     when tt=1 then do
  118.     do i=1 to ndv
  119.         y2 = (y0)+i*(h/ndv)
  120.         y2 = y2%1
  121.         'DRAWMODE(-1)'
  122.         do c=1 to 9
  123.         yc = y2-(h/ndv)/10*c
  124.         yc=yc%1
  125.         'DRAW('x0','yc','x1','yc')'
  126.         end
  127.         'DRAWMODE(-2):DRAW('x0','y2','x1','y2')'
  128.     end
  129.     end
  130.     when tt=2 then do
  131.     if ~show('L','rexxmathlib.library') then
  132.        call addlib('rexxmathlib.library',0,-30)
  133.     y2=y1
  134.     do i=1 to ndv
  135.         'DRAWMODE(-2):DRAW('x0','y2','x1','y2')'
  136.         'DRAWMODE(-1)'
  137.         do c=2 to 9
  138.         yc=(h/ndv)*log10(c)
  139.         yc=(y2-yc)%1
  140.         'DRAW('x0','yc','x1','yc')'
  141.         end
  142.         y2 = y1-i*(h/ndv)
  143.         y2 = y2%1
  144.     end
  145.     end
  146.     when tt=3 then do
  147.     if ~show('L','rexxmathlib.library') then
  148.        call addlib('rexxmathlib.library',0,-30)
  149.  
  150.     y2=y0
  151.  
  152.     do i=1 to ndv
  153.         'DRAWMODE(-1)'
  154.         do c=2 to 9
  155.         yc=(h/ndv)*log10(c)
  156.         yc=(y2+yc)%1
  157.         'DRAW('x0','yc','x1','yc')'
  158.         end
  159.         y2 = (y0)+i*(h/ndv)
  160.         y2 = y2%1
  161.         'DRAWMODE(-2):DRAW('x0','y2','x1','y2')'
  162.     end
  163.     end
  164.     otherwise call quitter
  165. end
  166. call quitter
  167.  
  168. minima: procedure
  169.     parse arg v1,v2
  170.     if v1<v2 then return v1
  171.     return v2
  172. end
  173.  
  174. maxima: procedure
  175.     parse arg v1,v2
  176.     if v1>v2 then return v1
  177.     return v2
  178. end
  179.  
  180. quitter: procedure expose clip
  181.     if clip>=0 then 'CLIPUNIT('clip')'
  182.     exit
  183.  
  184. /* Traitement des erreurs, interruption du programme */
  185. syntax:
  186. erreur=RC
  187. 'MESSAGE("Script grille.AmiCAD"+CHR(10)+"Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
  188. call quitter
  189.  
  190. error:
  191. 'MESSAGE("Script grille.AmiCAD"+CHR(10)+"Erreur en ligne 'SIGL'")'
  192. call quitter
  193.